MacHack 1996

home *** CD-ROM | disk | FTP | other *** search

/ MacHack 1996 / MacHack 1996.toast / Hacks / Hacks ’92 / HyperInitMaker... / TinyInit < prev

Wrap

Text File | 1992-06-19 | 42.7 KB | 1,339 lines | [TEXT/EDIT]

-- HyperINIT, a hack for MacHack -- Quick Debug version 1992 June 19 -- Copyright 1992 Itty Bitty Computers global UpperStr:R[256], myHandles:P, QuickDraw:R[256], Intl0:P, HCardX:L, global myXcmdBlock:R[128], newXcmdBlock:P, toknType:C, doMyCommAd:P global funMod:L, expnPtr:P, expnValu:R[268], expnType:C, exValPtr:P -- parser stuff global clicker:L, resType:C, resValue:L, currentX:L -- ClickLoc & the result global NameList:P, OffList:P, CommNames:L, FuncNames:L, GlobNames:L, ResWords:L -- each item in OffList: 0=nameoffs,4=linkoffs,8=+resId&recur/-code#/type,10=data -- first of ResWords is ItemDelimiter, NumberFormat, then chunkies global ActiveXcmdBlk:P, XgrafPort:P, WinSeqNum:L, tempChar:C, Stripper:L global myExit:R[64],iRect:R,pRect:R on HyperINIT --Debugger inline *myExit,$48D0,$FFFF -- also hand-patch param pop in glue exit code add 24 to myExit.long[16] --debug CodeResource InitializeAll true -- as required by Toolbox etc. put "StartUp" into WorkingString get DoCommand(WorkingStringAdr(),CommNames) ShowInit 256 inline *myExit,$4CD0,$FFFF,$4E75 end HyperINIT on ErrorOffQuick --- DebugStr ";g" ShowInit 257 inline *myExit,$4CD0,$FFFF,$4E75 --- DebugStr ";g" end ErrorOffQuick on ShowInit theID -- sorry, guys, I ran out of time... exit ShowInit --- put GetResource("ICN#",theID) into hand if hand = nil then exit ShowInit OpenPort myPort setRect iRect,0,0,32,32 setRect pRect,00,00,32,32 --- ?? HLock hand put hand@.long+128 into myXcmdBlock.baseAddr put 4 into myXcmdBlock.rowBytes put 0 into myXcmdBlock.bounds.topLeft put 32*65536+32 into myXcmdBlock.bounds.botRight CopyBits myXcmdBlock,myPort@.portBits,iRect,pRect,3,nil put hand@.long into myXcmdBlock.baseAddr CopyBits myXcmdBlock,myPort@.portBits,iRect,pRect,1,nil end ShowInit on TerminateString astr,thestr --- DebugStr ";g" put thestr@.str into astr@.str put astr+1 into expnPtr ZapString astr Getokenn --- DebugStr ";g" end TerminateString function DoCommand thestr,theList --- DebugStr ";g" INLINE $9EFC,$0190,+400 put CPUstackPtr() into fraim TerminateString fraim+128,thestr put LookupName(theList+0,OffList,NameList) into offs if offs is not 0 then get HandlePeekWord(OffList,offs+8) if it>0 then if CallCode(offs,fraim,16,0) is false then return false if expnPtr@.chr>space then return DisposeIfHandle(chartonum(expnType),expnValu.long) else if fraim@.passflag then if expnValu.long is not nil then DisposHandle expnValu.long return DoCommand(fraim+128,HandlePeekLong(OffList,8)) else return true else return DoMyCommand(-it) else return false --- DebugStr ";g" end DoCommand on TextCommand --- DebugStr ";g" if ActiveXcmdBlk@.request=1 then get CommNames else get HandlePeekLong(OffList,8) if DoCommand(ActiveXcmdBlk@.inargs.long,it) then put expnValu.long into ActiveXcmdBlk@.outargs1.long else put 1 into ActiveXcmdBlk@.resultx --- DebugStr ";g" end TextCommand on EvalExpn --- DebugStr ";g" INLINE $9EFC,$0104,+260 TerminateString CPUstackPtr(),ActiveXcmdBlk@.inargs.long if ParseExpn(chartonum("H"),false) then put expnValu.long into ActiveXcmdBlk@.outargs1.long else put 1 into ActiveXcmdBlk@.resultx put ActiveXcmdBlk@.outargs1.long into aptr inline *aptr --- DebugStr ";dm @@a0;g" end EvalExpn on tryForXcmd --- DebugStr ";g" put LookupName(CommNames,OffList,NameList) into offs if offs is not 0 then put ActiveXcmdBlk into expnValu.long if HandlePeekByte(OffList,offs+10)<128 then put ActiveXcmdBlk into expnValu.str put Nextoken into WorkingString AppendChar " " AppendString expnValu.str put DoCommand(WorkingStringAdr(),offs) into didit else put DoCommand(WorkingStringAdr()-512,offs) into didit if didit then put expnValu.long into ActiveXcmdBlk@.outargs1.long else put 1 into ActiveXcmdBlk@.resultx else put 2 into ActiveXcmdBlk@.resultx --- DebugStr ";g" end tryForXcmd on notImplemented --- DebugStr ";g" put "unimplementedcallback" into Nextoken tryForXcmd --- DebugStr ";g" end notImplemented on fieldAccess DebugStr "oops" end fieldAccess on ShellHook DebugStr "oops" end ShellHook on SimpleCallback --- DebugStr ";g" get ActiveXcmdBlk@.request if it=4 then -- 004,stringmatch put ActiveXcmdBlk@.inargs.long into aptr inline *aptr --- DebugStr ";dm @a0;g" put ActiveXcmdBlk@.inargs.off4.long into aptr inline *aptr --- DebugStr ";dm @a0 20;g" get OffsetString(ActiveXcmdBlk@.inargs.long, ¬ StrLength(ActiveXcmdBlk@.inargs.long@.str),ActiveXcmdBlk@.inargs.off4.long) if it>0 then get it+ActiveXcmdBlk@.inargs.off4.long-1 put it into ActiveXcmdBlk@.outargs1.long else if it=6 then -- 006,zerobytes put ActiveXcmdBlk@.inargs.long into aptr put ActiveXcmdBlk@.inargs.off4.long into nbytes if aptr mod 2 + nbytes mod 2 = 0 then repeat nbytes div 2 put 0 into aptr@.int add 2 to aptr end repeat else repeat nbytes put chartonum(0) into aptr@.chr add 1 to aptr end repeat else if it=18 then -- 018,getglobal put ActiveXcmdBlk@.inargs.long@.str into Nextoken if LeftEx(true,1) then -- -- ** -2C2+858+140 if expnType is not "H" then ConvertType chartonum("H") if expnValu.long=nil then put NewHandleClear(2) into expnValu.long put (expnValu.long = nil) into ActiveXcmdBlk@.resultx else if HandToHand(expnValu.ptrtype) is not 0 then put 1 into ActiveXcmdBlk@.resultx put 0 into expnValu.long end if put expnValu.long into ActiveXcmdBlk@.outargs1.long else put 1 into ActiveXcmdBlk@.resultx put ActiveXcmdBlk@.outargs1.long into aptr inline *aptr --- DebugStr ";dm @@a0;g" else if it=19 then -- 019,setglobal put ActiveXcmdBlk@.inargs.long@.str into Nextoken if LeftEx(false,1) then put ActiveXcmdBlk@.inargs.off4.long into aptr if HandToHand(aptr) is not 0 then put 1 into ActiveXcmdBlk@.resultx else if PutGlobal(expnValu.off4.long,chartonum("H"),aptr) then get 0 else put 1 into ActiveXcmdBlk@.resultx else put 1 into ActiveXcmdBlk@.resultx else if it=27 then -- 027,returntopas put ActiveXcmdBlk@.inargs.long into aptr put ActiveXcmdBlk@.inargs.off4.long into this repeat 255 get chartonum(aptr@.chr) if it<32 then if it=13 or it=0 then exit repeat add 1 to aptr add 1 to this put numtochar(it) into this@.chr end repeat put ActiveXcmdBlk@.inargs.off4.long into aptr put numtochar(this-aptr) into aptr@.chr end if --- DebugStr ";g" end SimpleCallback on WindowStuff DebugStr "oops" end WindowStuff on CallBackVector ShellHook -- 000,ShellHook TextCommand -- 001,sendcardmessage EvalExpn -- 002,evalexpr SimpleCallback -- 003,stringlength SimpleCallback -- 004,stringmatch TextCommand -- 005,sendhcmessage SimpleCallback -- 006,zerobytes SimpleCallback -- 007,pastozero SimpleCallback -- 008,zerotopas SimpleCallback -- 009,strtolong SimpleCallback -- 010,strtonum SimpleCallback -- 011,strtobool SimpleCallback -- 012,strtoext SimpleCallback -- 013,longtostr SimpleCallback -- 014,numtostr SimpleCallback -- 015,numtohex SimpleCallback -- 016,booltostr SimpleCallback -- 017,exttostr SimpleCallback -- 018,getglobal SimpleCallback -- 019,setglobal fieldAccess -- 020,getfieldbyname fieldAccess -- 021,getfieldbynum fieldAccess -- 022,getfieldbyid fieldAccess -- 023,setfieldbyname fieldAccess -- 024,setfieldbynum fieldAccess -- 025,setfieldbyid SimpleCallback -- 026,stringequal SimpleCallback -- 027,returntopas SimpleCallback -- 028,scantoreturn notImplemented -- 029,getmaskanddata notImplemented -- 030,changedmaskanddata notImplemented -- 031,formatscript SimpleCallback -- 032,zerotermhandle notImplemented -- 033,printtehandle SimpleCallback -- 034,sendhcevent notImplemented -- 035,hcwordbreakproc WindowStuff -- 036,beginxsound WindowStuff -- 037,endxsound notImplemented -- 038,runhandler SimpleCallback -- 039,scantozero SimpleCallback -- 040,getxresinfo SimpleCallback -- 041,getfilepath SimpleCallback -- 042,frontdocwindow SimpleCallback -- 043,pointtostr SimpleCallback -- 044,recttostr SimpleCallback -- 045,strtopoint SimpleCallback -- 046,strtorect notImplemented -- 047,getfieldte notImplemented -- 048,setfieldte notImplemented -- 049,getobjectname notImplemented -- 050,getobjectscript notImplemented -- 051,setobjectscript notImplemented -- 052,stacknametonum notImplemented -- 053,notify notImplemented -- 054,showhcalert notImplemented -- 055 WindowStuff -- 100,getnewxwindow,newxwindow WindowStuff -- 101,closexwindow WindowStuff -- 102,setxwidletime WindowStuff -- 103,xwhasinterruptcode WindowStuff -- 104,registerxwmenu WindowStuff -- 105,beginxwedit,endxwedit notImplemented -- 106,savexwscript notImplemented -- 107,getcheckpoints notImplemented -- 108,setcheckpoints WindowStuff -- 109,xwallowreentrancy WindowStuff -- 110,sendwindowmessage notImplemented -- 111,hidehcpalettes notImplemented -- 112,showhcpalettes WindowStuff -- 113,xwalwaysmovehigh end CallBackVector on myGlobals -- to save A6 in DebugStr "oops" end myGlobals on CallBackDispatcher inline $48E7,$FFFE,+60,$7E00,*myGlobals,$2C50 -- save regs, reload put ActiveXcmdBlk into oldXcmdBlock put newXcmdBlock into ActiveXcmdBlk inline *myHandles,$2C10,*myXcmdBlock,$2848,*newXcmdBlock,$208C put 0 into ActiveXcmdBlk@.resultx put nil into ActiveXcmdBlk@.outargs1.long put nil into ActiveXcmdBlk@.outargs1.off4.long put nil into ActiveXcmdBlk@.outargs1.off8.long put nil into ActiveXcmdBlk@.outargs1.off8.off4.long inline *ActiveXcmdBlk --- DebugStr ";dm a7 80;dm @a0 70;g" get ActiveXcmdBlk@.request if it<114 and it>0 or it=16384 then if it=16384 then get 0 else if it>55 then get it-44 -- 100 -> 56 inline *it,$2010,$E580,*CallBackVector,$4EB0,$000C else notImplemented if ActiveXcmdBlk@.resultx=1 then put "failedcallback" into Nextoken tryForXcmd if ActiveXcmdBlk@.resultx=2 then put 1 into ActiveXcmdBlk@.resultx end if inline *ActiveXcmdBlk --- DebugStr ";dm @a0 80;g" put ActiveXcmdBlk into newXcmdBlock put oldXcmdBlock into ActiveXcmdBlk inline $4CDF,$7FFF,-60 -- then exit normally end CallBackDispatcher on myGrowZone gotit,needBytes DebugStr "oops" get needBytes+gotit end myGrowZone on InitializeAll initstoo --- DebugStr ";g" if initstoo then inline $2C4D -- copy A5 to A6 inline *myHandles,$2086,*myGlobals,$208E -- save D6,A6 put 0 into this inline *CallBackDispatcher,$2008,*this,$2080 put this into myXcmdBlock.off64.off8.long inline *myXcmdBlock,$2848,*newXcmdBlock,$208C inline *CallBackVector,$2008,*this,$2080 add 12 to this repeat 70 put $6000 into this@.int add 4 to this end repeat inline *expnValu,$2008,*exValPtr,$2080 inline *QuickDraw,$2008,*this,$2080 InitGraf this+240 if GetTrapAddressNewOS($A055)=GetTrapAddressNewTool($A89F) then put Lo3Bytes into Stripper else put StripAddress(-1) into Stripper put WorkingStringAdr()-512 into tokad put GetResource("DATA",129) into NameList if NameList is nil then ErrorOffQuick get HandlePeekLong(NameList,4) SetHandleSize NameList,it if GetHandleSize(NameList) is not it then ErrorOffQuick put GetResource("DATA",128) into OffList if OffList is nil then ErrorOffQuick get HandlePeekLong(OffList,4) SetHandleSize OffList,it if GetHandleSize(OffList) is not it then ErrorOffQuick put CurResFile() into this put "XCMD" into theType put 0 into FuncNames put 0 into HCardX repeat 2 put FuncNames into CommNames if FuncNames is not 0 then put "XFCN" into theType put HandlePeekLong(OffList,12) into FuncNames else put HandlePeekLong(OffList,8) into FuncNames get 0 repeat with index=1 to Count1Resources(theType) get 0 put Get1IndResource(theType,index) into hand if GetHandleSize(hand)>33000 then put true into initstoo GetResInfo hand,theID,theType,Nextoken put tokad+StrLength(Nextoken) into offs if offs@.chr="•" then put 32768 into offs put tokad@.int-256 into tokad@.int else put 0 into offs DeCapToken if StrLength(Nextoken)+NameList@@.long+2>HandlePeekLong(NameList,4) then get HandlePeekLong(NameList,4)+256 SetHandleSize NameList,it if GetHandleSize(NameList) is not it then ErrorOffQuick HandlePokeLong it,NameList,4 end if if OffList@@.long+16>HandlePeekLong(OffList,4) then get HandlePeekLong(OffList,4)+256 SetHandleSize OffList,it if GetHandleSize(OffList) is not it then ErrorOffQuick HandlePokeLong it,OffList,4 end if get OffList@@.long put it+16 into OffList@@.long HandlePokeLong HandlePeekLong(NameList,0),OffList,it HandlePokeLong FuncNames,OffList,it+4 HandlePokeLong theID*65536+offs,OffList,it+8 HandlePokeLong 0,OffList,it+12 put it into FuncNames put NameList@@.long+NameList@.long into aptr put Nextoken into aptr@.str put NameList@@.long+StrLength(Nextoken)+2-StrLength(Nextoken) mod 2 into NameList@@.long if offs>0 then if theType="XCMD" then if Nextoken="hypercard" then put FuncNames into HCardX get 0 end repeat get 0 end repeat put HandlePeekLong(OffList,16) into GlobNames put GlobNames into ResWords put GetResource("INTL",0) into Intl0 if Intl0=nil then ErrorOffQuick HNoPurge Intl0 if initstoo then InitFonts InitWindows TEInit InitDialogs nil end if InitCursor get DoMyCommand(0) repeat with index=1 to 255 put numtochar(index) into UpperStr.chr[index] end repeat put numtochar(255) into UpperStr.chr UprString UpperStr.str,true --SetGrowZone this put 0 into currentX put 0 into WinSeqNum put 0 into hasEdit put 0 into hasSound put WMgrPort into XgrafPort --- DebugStr ";g" end InitializeAll function DoMyCommand theCode --- DebugStr ";g" if theCode=0 then inline *DoMyCommand,$2008,*theCode,$2080 put theCode+12 into doMyCommAd return true else if theCode<0 then put -theCode into theCode put theCode mod 2 ≠0 into tf get theCode div 2 if it=1 then return false return LeftEx(tf,it) else if theCode<32 then return CommandParse(theCode) else return FunctionParse(theCode) --- DebugStr ";g" end DoMyCommand function CommandParse theCode --- DebugStr ";g" INLINE $9EFC,$0220,+544 put CPUstackPtr() into sptr if theCode=31 then return true -- any system msg else if theCode=30 then -- quit ExitToShell else if theCode+0=1 then -- get if not ParseExpn(chartonum("H"),true) then return false PutIntoIt else if theCode=2 then -- put if not ParseExpn(0,true) then return false put "into,before,after" into WorkingString put TokIsItemOfWS() into offs return PutItThere(offs) else if theCode=5 then -- beep if not ParseExpn(chartonum("I"),true) then put 1 into expnValu.long repeat expnValu.long mod 8 SysBeep 20 end repeat else return false --- DebugStr ";g" return true end CommandParse function FunctionParse theCode --- DebugStr ";g" INLINE $9EFC,$0208,+520 put CPUstackPtr() into sptr put (FirstCharOf(Nextoken)="(") into parens if theCode+0=33 then -- ticks put ticks into expnValu.long put "I" into expnType else if theCode=34 then -- seconds put Time into expnValu.long put "U" into expnType else if theCode=39 then -- result put resValue into expnValu.long if resType="H" then get HandToHand(expnValu.ptrtype) put resType into expnType else if theCode=66 then -- screenrect put ScreenBits.bounds.topLeft into expnValu.topLeft put ScreenBits.bounds.botRight into expnValu.botRight put "Y" into expnType else return false if parens then Getokenn --- DebugStr ";g" return true end FunctionParse function PutItThere kin -- kin selects from: into,before,after --- DebugStr ";g" INLINE $9EFC,$0208,+520 put CPUstackPtr() into sptr put expnPtr into xptr Getokenn put xptr into expnPtr SaveExpn exValPtr-4,sptr Getokenn if not LeftEx(false,0) then return DisposeIfHandle(chartonum(sptr@.chr),sptr@.off4.long) put expnValu.off4.long into offs if expnType="K" then put sptr+260 into xptr BlockMove exValPtr,xptr,12 SaveExpn sptr,exValPtr-4 if not InBitSet(chartonum(expnType)-64,$80100) -- HS then ConvertType chartonum("S") if expnType="H" then put StringLength(expnValu@.long) into len put expnValu@.long into aptr else put StrLength(expnValu.str) into len -- "S" put exValPtr+1 into aptr end if if xptr@.long=nil then if xptr@.off8.long=len then BlockMove aptr,xptr@.off4.long,len else return DisposeIfHandle(chartonum(expnType),expnValu.long) else if expnType="H" then if expnValu.long is not nil then HLock expnValu.long get Munger(xptr@.long,xptr@.off4.long,nil,xptr@.off8.long,aptr,len) get DisposeIfHandle(chartonum(expnType),expnValu.long) end if else if expnType="Q" then return false else get chartonum(sptr@.chr) if InBitSet(it mod 32,$84002) then -- .,A,N,S get chartonum("S") put sptr+4 into aptr else put sptr@.off4.long into aptr return PutGlobal(offs,it,aptr) end if --- DebugStr ";g" return true get kin+0 end PutItThere function CallCode offoff,fraim,pramex,flags --- DebugStr ";g" ZeroBytes fraim,128 if pramex>0 then Getokenn put 0 into offs put fraim+2 into aptr repeat if pramex=0 or StrLength(Nextoken)=0 or FirstCharOf(Nextoken)=")" then exit repeat if ParseExpn(chartonum("H"),false) is false then return false add 1 to offs put offs into fraim@.int put expnValu.long into aptr@.long add 4 to aptr if offs=pramex then exit repeat if FirstCharOf(Nextoken)="," then Getokenn end repeat return CallXCode(offoff+0,fraim,flags+0) end CallCode function ParseExpn typeWanted,readtoken --- DebugStr ";g" if readtoken then Getokenn if BoolTermEx(0) is false then return false repeat while Nextoken="or" Getokenn ConvertType chartonum("B") put expnValu.long into savedExpn if BoolTermEx(chartonum("B")) is false then return false if savedExpn is not zero then put 1 into expnValu.long end repeat ConvertType typeWanted+0 --- DebugStr ";g" return true end ParseExpn function BoolTermEx typeWanted --- DebugStr ";g" if BoolFactEx(0) is false then return false repeat while Nextoken="and" Getokenn ConvertType chartonum("B") put expnValu.long into savedExpn if BoolFactEx(chartonum("B")) is false then return false if savedExpn is zero then put 0 into expnValu.long end repeat ConvertType typeWanted+0 --- DebugStr ";g" return true end BoolTermEx function BoolFactEx typeWanted --- DebugStr ";g" INLINE $9EFC,$0110,+272 put CPUstackPtr() into sptr if BoolPrimEx(0) is false then return false put "<,≤,>,≥,=,≠,,,contains,is" into WorkingString get TokIsItemOfWS() if it>0 then Getokenn if it=3 then if FirstCharOf(Nextoken)="=" then Getokenn get 4 end if else if it=10 then get 5 else if it=1 then if FirstCharOf(Nextoken)="=" then get 2 else if FirstCharOf(Nextoken)=">" then get 6 if it>1 then Getokenn end if put it into opr if opr<7 then SaveExpn exValPtr-4,sptr+12 put chartonum(expnType) into saveType BlockMove exValPtr,sptr+12,256 if expnType="F" then get saveType else get 0 if BoolPrimEx(it) is false then return DisposeIfHandle(saveType,sptr@.off16.long) else if expnType="H" then put expnValu.long@.long into p2 put StringLength(p2) into n2 else if expnType="K" then put expnValu.long into p2 if p2≠0 then put p2@.long into p2 put p2+expnValu.off4.long into p2 put expnValu.off8.long into n2 else put StrLength(expnValu.str) into n2 put exValPtr+1 into p2 end if if numtochar(saveType)="H" then put sptr@.off16.long@.long into p1 put StringLength(p1) into n1 else if numtochar(saveType)="K" then put sptr@.off16.long into p2 if p2≠0 then put p2@.long into p2 put p2+sptr@.off16.off4.long into p2 put sptr@.off16.off8.long into n2 else put StrLength(sptr@.off16.str) into n1 put sptr+17 into p1 end if if opr<5 then put IUMagString(p1,p2,n1,n2) into cmpr else put IUMagIDString(p1,p2,n1,n2) into cmpr end if get DisposeIfHandle(chartonum(expnType),expnValu.long) get DisposeIfHandle(saveType,sptr@.off16.long) if opr<5 then if opr mod 2 =0 then put opr-cmpr≠3 into expnValu.bool else put opr-cmpr-2=0 into expnValu.bool else put opr-abs(cmpr)-5=0 into expnValu.bool else return false put "B" into expnType end if ConvertType typeWanted+0 --- DebugStr ";g" return true end BoolFactEx function BoolPrimEx typeWanted --- DebugStr ";g" if STermEx(0) is false then return false ConvertType typeWanted+0 --- DebugStr ";g" return true end BoolPrimEx function SExpnEx typeWanted --- DebugStr ";g" INLINE $9EFC,$0010,+16 put CPUstackPtr() into sptr if STermEx(0) is false then return false repeat put chartonum(FirstCharOf(Nextoken)) into opr if not InBitSet(opr-32,$2800) then exit repeat -- +,- Getokenn ConvertType chartonum("F") MathFunction 0,sptr if STermEx(chartonum("F")) is false then return false if numtochar(opr)="+" then MathFunction 4,sptr else MathFunction 5,sptr end repeat ConvertType typeWanted+0 --- DebugStr ";g" return true end SExpnEx function STermEx typeWanted --- DebugStr ";g" INLINE $9EFC,$0010,+16 put CPUstackPtr() into sptr if SFactEx(0) is false then return false repeat if StrLength(Nextoken)=1 then put chartonum(FirstCharOf(Nextoken)) into opr else if Nextoken="div" then put chartonum("%") into opr else if Nextoken="mod" then put chartonum("#") into opr else put 0 into opr if not InBitSet(opr-32,$8424) then exit repeat -- #,%,*,/ Getokenn if opr<chartonum("*") then ConvertType chartonum("I") put expnValu.long into saveLong else ConvertType chartonum("F") MathFunction 0,sptr end if put chartonum(expnType) into saveType if SFactEx(chartonum(expnType)) is false then return false if numtochar(opr)="#" then MathFunction 3,saveLong else if numtochar(opr)="%" then MathFunction 2,saveLong else if numtochar(opr)="*" then MathFunction 6,sptr else MathFunction 7,sptr end repeat ConvertType typeWanted+0 --- DebugStr ";g" return true end STermEx function SFactEx typeWanted --- DebugStr ";g" INLINE $9EFC,$0010,+16 put CPUstackPtr() into sptr if SPrimEx(0) is false then return false ConvertType typeWanted+0 --- DebugStr ";g" return true end SFactEx function SPrimEx typeWanted --- DebugStr ";g" put true into gotit if FirstCharOf(Nextoken)="-" then Getokenn if SPrimEx(0) is false then return false if InBitSet(chartonum(expnType)-64,$15200) then -- I,L,N,P ConvertType chartonum("I") put -expnValu.long into expnValu.long else ConvertType chartonum("F") MathFunction 1,0 end if else if Nextoken="not" then Getokenn if SPrimEx(chartonum("B")) is false then return false put not expnValu.bool into expnValu.bool else if FirstCharOf(Nextoken)="(" then if ParseExpn(0,true) is false then return false if FirstCharOf(Nextoken)≠")" then return DisposeIfHandle(chartonum(expnType),expnValu.long) Getokenn else if toknType=quote then put "S" into expnType put Nextoken into expnValu.str Getokenn else if toknType="N" or toknType="." then put toknType into expnType put Nextoken into expnValu.str Getokenn else if toknType≠"A" then return false else if Nextoken="the" then Getokenn put "short,long,abbr,abbrev,abbreviated," into WorkingString put TokIsItemOfWS() into funMod if funMod>0 then Getokenn put Nextoken into expnValu.str put expnPtr into savePtr Getokenn if Nextoken="of" then put 1 into pramex else put 0 into pramex put savePtr into expnPtr put expnValu.str into Nextoken put DoFunction(pramex) into gotit else put Nextoken into expnValu.str put expnPtr into savePtr Getokenn put Nextoken into WorkingString put expnValu.str into Nextoken put savePtr into expnPtr if FirstCharOf(WorkingString)="(" then put DoFunction(16) into gotit else if WorkingString="of" then put DoFunction(1) into gotit else if not LeftEx(true,0) then return false if expnType="H" then if expnValu.long≠nil then put HandToHand(expnValu.ptrtype)=0 into gotit end if end if if gotit is false then return false end if ConvertType typeWanted+0 --- DebugStr ";g" return true end SPrimEx function LeftEx derefit, varoff put Nextoken into WorkingString AppendString ";dm a7+24;g" --- DebugStr WorkingString put varoff+0 into offs if varoff<2 then put LookupName(GlobNames,OffList,NameList) into offs if offs is not 0 then put OffList@.long+offs+10 into expnValu.long put offs into expnValu.off4.long put numtochar(HandlePeekByte(OffList,offs+8)) into expnType if expnType="C" then if derefit then put "S" into expnType put HandlePeekByte(OffList,offs+9)+256 into expnValu.int else subtract 1 from expnValu.long else if expnType="S" then if derefit then BlockMove OffList@.long+offs+9,aptr,HandlePeekByte(OffList,offs+9)+1 else subtract 1 from expnValu.long else if expnType="H" then put HandlePeekLong(OffList,offs+10) into expnValu.long else if derefit then if expnType="F" then BlockMove OffList@.long+offs+10,aptr,12 else put HandlePeekLong(OffList,offs+10) into expnValu.long -- I,L,P end if else -- create new global put Nextoken into expnValu.str put "S" into expnType ConvertType chartonum("H") if StrLength(Nextoken)+NameList@@.long+2>HandlePeekLong(NameList,4) then get HandlePeekLong(NameList,4)+256 SetHandleSize NameList,it if GetHandleSize(NameList) is not it then return false HandlePokeLong it,NameList,4 end if if OffList@@.long+14>HandlePeekLong(OffList,4) then get HandlePeekLong(OffList,4)+256 SetHandleSize OffList,it if GetHandleSize(OffList) is not it then return false HandlePokeLong it,OffList,4 end if put OffList@@.long into offs HandlePokeLong HandlePeekLong(NameList,0),OffList,offs HandlePokeLong GlobNames,OffList,offs+4 HandlePokeLong offs+14,OffList,0 HandlePokeWord chartonum("H")*256,OffList,offs+8 HandlePokeLong expnValu.long,OffList,offs+10 put offs into GlobNames put offs into expnValu.off4.long DeCapToken put NameList@@.long+NameList@.long into aptr put Nextoken into aptr@.str put NameList@@.long+StrLength(Nextoken)+2-StrLength(Nextoken) mod 2 into NameList@@.long end if if varoff=0 then Getokenn ConvertType 0 ---- debug only ---- --- DebugStr ";g" return true end LeftEx function DoFunction pramex --- DebugStr ";g" INLINE $9EFC,$0190,+400 put CPUstackPtr() into fraim if pramex<0 then put LookupName(HandlePeekLong(OffList,12),OffList,NameList) into offs put -1-pramex into pramex else put LookupName(FuncNames,OffList,NameList) into offs if offs is not 0 then get HandlePeekWord(OffList,offs+8) if it>0 then put fraim+128 into savePtr put Nextoken into savePtr@.str put expnPtr into savePtr if pramex>0 then Getokenn if CallCode(offs,fraim,pramex,32768) is false then return false if fraim@.passflag then get DisposeIfHandle(chartonum(expnType),expnValu.long) put savePtr into expnPtr put fraim+128 into savePtr put savePtr@.str into Nextoken return DoFunction(-1-pramex) else return true else return DoMyCommand(-it) else return false --- DebugStr ";g" end DoFunction function PutGlobal offs, itsType, theVal --- DebugStr ";dm a7+1C;g" put numtochar(HandlePeekByte(OffList,offs+8)) into tempChar if itsType≠0 then put numtochar(itsType) into expnType if expnType="S" then put theVal@.str into expnValu.str else if InBitSet(chartonum(expnType)-64,$6000040) then -- F,Y,Z BlockMove theVal,exValPtr,14 else put theVal into expnValu.long end if ConvertType chartonum(tempChar) put OffList@.long+offs+10 into aptr if expnType="H" then get aptr@.long put expnValu.long into aptr@.long get DisposeIfHandle(chartonum("H"),it) else if InBitSet(chartonum(expnType)-64,$1311200) then -- I,L,P,T,U,X put expnValu.long into aptr@.long else if expnType="F" then MathFunction 0,aptr else if InBitSet(chartonum(expnType)-64,$6) then -- B,C subtract 1 from aptr put expnValu.chr into aptr@.chr else if expnType="S" then subtract 1 from aptr if aptr@.chr=expnValu.chr then put expnValu.str into aptr@.str else return false else if expnType="Y" then put expnValu.long into aptr@.long put expnValu.off4.long into aptr@.off4.long else if expnType="Z" then BlockMove exValPtr,aptr,14 else return false --- DebugStr ";g" return true end PutGlobal on PutIntoIt --- DebugStr ";g" put "it" into Nextoken put LookupName(GlobNames,OffList,NameList) into offs if offs>0 then return PutGlobal(offs,0,0) else return DisposeIfHandle(chartonum(expnType),expnValu.long) --- DebugStr ";g" end PutIntoIt function CallXCode offoff,fraim,flags --- DebugStr ";dm a7+30 30;g" -- load XCMD or XFCN, parse its params into newXcmdBlock, and call it put HandlePeekWord(OffList,offoff+10)+1 into recurs if recurs=0 then return false if recurs > -2 then HandlePokeWord recurs,OffList,offoff+10 put HandlePeekWord(OffList,offoff+8) into resID if BitAnd(flags,32768)=0 then put "XCMD" into expnValu.OStype else put "XFCN" into expnValu.OStype put GetResource(expnValu.OStype,resID) into hand if hand is nil then return false if hand ≠ HandlePeekLong(OffList,offoff+12) then HandlePokeLong hand,OffList,offoff+12 if recurs<0 then put -1 into recurs else put 1 into recurs HandlePokeWord recurs,OffList,offoff+10 end if if recurs<2 then if flags mod 8 > 1 then MoveHHi hand -- *** not 64K ROMs *** HLock hand put newXcmdBlock into oldXcmdBlock put fraim into newXcmdBlock put fraim@.int into offs put currentX into oldX put offoff into currentX if fraim@.int≥0 then SetPort XgrafPort put oldXcmdBlock@.off64.off8.long into newXcmdBlock@.off64.off8.long inline *newXcmdBlock,$2F10,+4,*hand,$2050,$2050,$4E90,-4 put newXcmdBlock@.passFlag into passed put newXcmdBlock@.returnvalue into expnValu.long put "H" into expnType put newXcmdBlock+2 into fraim repeat offs get fraim@.long if it is not nil then if it≠expnValu.long then DisposHandle it add 4 to fraim end repeat put oldX into currentX put oldXcmdBlock into newXcmdBlock get HandlePeekWord(OffList,offoff+10) if it> -2 then HandlePokeWord it-1,OffList,offoff+10 if it<2 then if flags mod 4 < 2 then HUnlock hand --- DebugStr ";g" return not passed end CallXCode on ConvertType typeWanted inline *exValPtr --- DebugStr ";dm a7+20;dm a0;g" INLINE $9EFC,$0100,+256 put CPUstackPtr() into sptr put numtochar(typeWanted) into tempChar if tempChar<"B" then exit ConvertType if expnType="." or expnType="N" then put "S" into expnType if expnType="S" then if StrLength(expnValu.str)=0 then put 0 into expnValu.long if tempChar="H" then put tempChar into expnType end if if tempChar=expnType then exit ConvertType if InBitSet(chartonum(expnType)-64,$1311200) and InBitSet(typeWanted-64,$1311200) then get 0 -- both I,L,P,T,U,X else if expnType="S" and tempChar="H" then put StrLength(expnValu.str) into len put NewHandle(len+1) into hand if hand is not nil then BlockMove exValPtr+1,hand@,len HandlePokeByte 0,hand,len end if put hand into expnValu.long else if expnType="H" and tempChar="S" then put expnValu.long into hand if hand is not nil then put StringLength(hand@.long) into len if len>255 then put 255 into len BlockMove hand@,exValPtr+1,len put numtochar(len) into expnValu.chr DisposHandle hand end if else if tempChar="B" then if not InBitSet(chartonum(expnType)-64,$211200) then -- I,L,P,U ConvertType chartonum("S") put expnValu.str into expnValu.bool put "B" into tempChar else put expnValu.long mod 2 into expnValu.bool else if expnType="B" then if not InBitSet(typeWanted-64,$211200) then -- I,L,P,U put expnValu.bool into expnValu.str put "S" into expnType ConvertType typeWanted else put expnValu.bool into expnValu.long else if expnType="U" then if tempChar="F" then MathFunction 13,aptr put "F" into expnType else LongToStr expnValu.long,exValPtr put "S" into expnType ConvertType typeWanted end if else if expnType="F" then if not InBitSet(typeWanted-64,$211200) then -- I,L,P,U MathFunction 15,aptr put "S" into expnType ConvertType typeWanted else MathFunction 11,aptr else if tempChar="F" then if not InBitSet(chartonum(expnType)-64,$11200) then -- I,L,P ConvertType chartonum("S") MathFunction 14,aptr put "F" into tempChar else MathFunction 12,aptr else if InBitSet(chartonum(expnType)-64,$11200) then put expnValu.long into expnValu.str put "S" into expnType ConvertType typeWanted else if InBitSet(typeWanted-64,$11200) then ConvertType chartonum("S") put expnValu.str into expnValu.long put "L" into tempChar else if expnType="X" then IntArray sptr,exValPtr,-2 put sptr@.str into expnValu.str put "S" into expnType ConvertType typeWanted else if expnType="Y" then IntArray sptr,exValPtr,-4 put sptr@.str into expnValu.str put "S" into expnType ConvertType typeWanted else if tempChar="X" then ConvertType chartonum("S") put expnValu.str into sptr@.str IntArray sptr,exValPtr,2 put "X" into tempChar else if tempChar="Y" then ConvertType chartonum("S") put expnValu.str into sptr@.str IntArray sptr,exValPtr,4 put "Y" into tempChar else if tempChar="C" then put expnValu.long into hand if expnType≠"H" then ConvertType chartonum("S") put expnValu.str into expnValu.chr put "C" into expnType else if hand is not nil then put hand@@.chr into expnValu.chr DisposHandle hand end if else if expnType="C" then put expnValu.chr into expnValu.str put "S" into expnType ConvertType typeWanted else if expnType="T" then put expnValu.long into expnValu.off8.long put expnValu.off8.OStype into expnValu.str put "S" into expnType ConvertType typeWanted else if tempChar="T" then put expnValu.long into hand if expnType≠"H" then ConvertType chartonum("S") put expnValu.str into expnValu.off8.OStype put expnValu.off8.long into expnValu.long put "T" into expnType else if hand is not nil then put hand@@.long into expnValu.long DisposHandle hand end if else exit ConvertType put tempChar into expnType --- DebugStr ";g" end ConvertType function TokIsItemOfWS --- DebugStr ";g" INLINE $9EFC,$0110,+272 put CPUstackPtr() into sptr put WorkingString into sptr@.str ZapString sptr put WorkingStringAdr()-511 into aptr put OffsetString(aptr,StrLength(Nextoken),sptr+1) into offs put offs+sptr+StrLength(Nextoken) into aptr if aptr@.chr is not "," then return 0 if offs<2 then return offs put offs+sptr-1 into aptr if aptr@.chr is not "," then return 0 put 1 into offs repeat until aptr=sptr if aptr@.chr="," then add 1 to offs subtract 1 from aptr end repeat --- DebugStr ";g" return offs end TokIsItemOfWS on Getokenn --- DebugStr ";g" put "" into Nextoken put space into toknType put WorkingStringAdr()-512 into tokad repeat while expnPtr@.chr=space add 1 to expnPtr end repeat if expnPtr@.chr<space then exit Getokenn put expnPtr into tokptr put 0 into quotedtok put GetLetter(expnPtr) into letcode if letcode > 256 then if letcode<512 then put "N" into toknType else put "A" into toknType repeat while letcode > 256 add 1 to expnPtr put GetLetter(expnPtr) into letcode if toknType="N" then if HandlePeekByte(Intl0,0)=letcode then put 768 into letcode put "." into toknType end if end repeat else if letcode=1 then add 1 to expnPtr put expnPtr into tokptr put quote into toknType put GetLetter(expnPtr) into letcode repeat while letcode>1 add 1 to expnPtr put GetLetter(expnPtr) into letcode end repeat if letcode>0 then put 1 into quotedtok add 1 to expnPtr else exit Getokenn else add 1 to expnPtr get expnPtr-tokptr if it=1 then put chartonum(tokptr@.chr) into letcode if letcode>64 and letcode<91 then add 32 to letcode put letcode+256 into tokad@.int else put numtochar(it) into tokad@.chr BlockMove tokptr,tokad+1,it if quotedtok>0 then put numtochar(it-1) into tokad@.chr -- else DeCapToken end if put Nextoken into WorkingString AppendString ";dm a0;g" inline *doMyCommAd --- DebugStr WorkingString end Getokenn function GetLetter txtptr --- DebugStr ";g" put chartonum(txtptr@.chr) into Nextok if Nextok<32 then return 0 if Nextok=34 then return 1 if Nextok>=48 and Nextok<58 then return Nextok+256 if Nextok=95 then return 607 if Nextok>64 and Nextok<91 or Nextok>96 and Nextok<123 then return Nextok+512 --- DebugStr ";g" return Nextok end GetLetter on DeCapToken put WorkingStringAdr()-512 into tokad put BitOr(tokad@.long,$202020) into tokad@.long if StrLength(Nextoken)<2 then put 0 into tokad@.off2.int else if StrLength(Nextoken)<3 then put BitAnd(tokad@.long,-256) into tokad@.long end DeCapToken function LookupName theList, OffHand, NameHand -- find Nextoken in OffHand beginning at offset theList, return offset if found put WorkingStringAdr()-512 into tokad put BitOr(tokad@.long,$202020) into first4 repeat if theList is 0 then return 0 put NameHand@.long+HandlePeekLong(OffHand,theList) into namePtr if namePtr mod 2 = 0 then if first4≠namePtr@.long then if StrLength(namePtr@.str)>2 then put HandlePeekLong(OffHand,theList+4) into theList next repeat end if if Nextoken=namePtr@.str then put Nextoken into WorkingString AppendString ";dm a7+24;g" --- DebugStr WorkingString return theList else put HandlePeekLong(OffHand,theList+4) into theList end repeat end LookupName function InBitSet theNum,theBits if BitAnd(theNum,-32) is not 0 then return false repeat theNum -- *** this could be faster with inline shift put theBits div 2 into theBits end repeat return theBits mod 2 ≠0 end InBitSet function DisposeIfHandle typeCode,hand if numtochar(typeCode)="H" or numtochar(typeCode)="K" then if hand is not nil then DisposHandle hand return false end DisposeIfHandle function OffsetString substr,lens,bigstr -- case insensitive, global-free -- return offset(substr@,bigstr@) where lens=length(substr) put bigstr into aptr if UpperStr.long=0 then repeat with index=1 to 255 put numtochar(index) into UpperStr.chr[index] end repeat put numtochar(255) into UpperStr.chr UprString UpperStr.str,true end if put UpperStr.chr[chartonum(substr@.chr)] into UpperStr.chr repeat repeat while UpperStr.chr[chartonum(aptr@.chr)]≠UpperStr.chr add 1 to aptr end repeat if chartonum(aptr@.chr)=0 then return 0 put substr into sptr repeat lens if UpperStr.chr[chartonum(aptr@.chr)]≠UpperStr.chr[chartonum(sptr@.chr)] then exit repeat add 1 to sptr add 1 to aptr end repeat if sptr-substr=lens then return aptr-bigstr-lens+1 put aptr-sptr+substr+1 into aptr end repeat end OffsetString function StringLength theStr -- =ScanToZero put theStr into aptr repeat until chartonum(aptr@.chr)=0 add 1 to aptr end repeat return aptr-theStr-1 end StringLength on ZapString theStr -- put terminal null after P-string pointed by theStr put theStr+StrLength(theStr@.str)+1 into sptr put numtochar(0) into sptr@.chr end ZapString on IntArray theStr,theInts,nints INLINE $9EFC,$0020,+32 put CPUstackPtr() into sptr if nints<0 then -- convert array of nints integers into P-string theStr put empty into theStr@.str repeat -nints put theInts@.int into sptr@.str put theStr@.str into WorkingString if StrLength(WorkingString)>0 then AppendChar "," AppendString sptr@.str put WorkingString into theStr@.str add 2 to theInts end repeat else repeat nints -- extract array of nints integers from theStr into theInts put 0 into thenum put 1 into sign repeat put theStr@.chr into ch if chartonum(ch)<space then exit repeat add 1 to theStr if ch="-" then put -sign into sign else if ch=space and thenum=0 then next repeat else if ch<"0" then exit repeat else if ch>"9" then exit repeat else put (thenum*4+thenum)*2+chartonum(ch)-48 into thenum end repeat if sign<0 then put -thenum into theInts@.int else put thenum into theInts@.int add 2 to theInts end repeat if false then aChar ch end IntArray on SaveExpn valPtr, savPtr put valPtr@.chr into savPtr@.chr get chartonum(valPtr@.chr) mod 32 if InBitSet(it,$84000) then -- N,S,. if StrLength(valPtr@.off4.str)<4 then get 0 else get 19 end if if InBitSet(it,$60A48C0) then -- F,G,K,N,Q,S,Y,Z if it=19 then get StrLength(valPtr@.off4.str)+1 -- "S" else if it=17 then get StrLength(valPtr@.off8.str)+5 -- "Q" else if it=7 and valPtr@.off4.off2.int=20 -- "G" then get StrLength(valPtr@.off4.off8.str)+13 else get 14 BlockMove valPtr+4,savPtr+4,it else put valPtr@.off4.long into savPtr@.off4.long -- B,C,H,I,L,P,T,U,X end SaveExpn on LongToStr theLong, theStr if theLong<3000000000 then -- both negative, first digit =2 put theLong-1000000000 into theStr@.str add 1 to theStr@.int else if theLong<4000000000 then -- both negative, first digit =3 put theLong-2000000000 into theStr@.str add 2 to theStr@.int else if theLong<0 then -- theLong slightly negative, first digit =4 put theLong-3000000000 into theStr@.str add 3 to theStr@.int else put theLong into theStr@.str end LongToStr